home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Turing / tmfile.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-25  |  6.5 KB  |  212 lines  |  [TEXT/3PRM]
  1. implementation module tmfile
  2.  
  3.  
  4. import    StdInt, StdBool, StdChar, StdString, StdFile, StdArray, StdClass
  5. from    deltaSystem import DirSeparator
  6. from    tm            import Turing, State, Tape, Transition, Head
  7.  
  8.     
  9. ::    *Disk        :==  Files
  10.  
  11. DummyTuring        :== {transitions=[],tape=DummyTape,state=""}
  12. DummyTape        :== {content="",head=0}
  13. DummyTrans        :== {start="",sigma=' ',end="",move=' '}
  14.  
  15.  
  16.  
  17. //    Write a Turing Machine to a file.
  18. WriteTuringToFile :: Turing !String !Disk -> (!Bool,!Disk)
  19. WriteTuringToFile turing fname disk
  20. #    (success,file,disk)    = fopen fname FWriteText disk
  21. |    not success            = (False,disk)
  22. #    file                = WritePartsToFile turing file
  23.     (_,disk)            = fclose file disk
  24. |    otherwise            = (True, disk)
  25. where
  26.     WritePartsToFile :: !Turing !*File -> *File
  27.     WritePartsToFile {transitions,tape} file
  28.     #    file    = WriteTransitionsToFile transitions    file
  29.         file    = WriteTapeToFile        tape            file
  30.     =    file
  31.     where
  32.         WriteTransitionsToFile :: ![Transition] !*File -> *File
  33.         WriteTransitionsToFile [trans:rest] file
  34.         #    file    = WriteTransitionToFile trans file
  35.             file    = WriteTransitionsToFile rest file
  36.         =    file
  37.         where
  38.             WriteTransitionToFile :: !Transition !*File -> *File
  39.             WriteTransitionToFile {start,sigma,end,move} file
  40.             #    file    = fwrites (String4 start)    file
  41.                 file    = fwritec ' '                file
  42.                 file    = fwritec sigma                file
  43.                 file    = fwrites "  ->  "            file
  44.                 file    = fwrites (String4 end)        file
  45.                 file    = fwritec ' '                file
  46.                 file    = fwritec move                file
  47.                 file    = fwritec '\n'                file
  48.             =    file
  49.             where
  50.                 String4 :: !String -> String
  51.                 String4 str
  52.                 |    len>=4        = str%(0,3)
  53.                 |    otherwise    = str+++"    "%(0,3-len) 
  54.                 where
  55.                     len            = size str
  56.         WriteTransitionsToFile _ file
  57.         =    fwrites "\nTape:\n" file
  58.  
  59.         WriteTapeToFile :: !Tape !*File -> *File
  60.         WriteTapeToFile {content} file
  61.             = fwrites (LimitContents content) file
  62.         where
  63.             LimitContents :: !String -> String
  64.             LimitContents cont
  65.             |    first>last        = "##"
  66.             |    fgood && lgood    = cont % (first-1, last+1)
  67.             |    lgood            = cont % (0, last+1)
  68.             |    fgood            = cont % (first-1, lmin1)
  69.             |    otherwise        = cont
  70.             where
  71.                 first            = FirstNonEmpty 0 lmin1 cont
  72.                 last            = LastNonEmpty lmin1 cont
  73.                 fgood            = first>0
  74.                 lgood            = last<lmin1
  75.                 lmin1            = size cont-1
  76.                 
  77.                 FirstNonEmpty :: !Int !Int String -> Int
  78.                 FirstNonEmpty i len str
  79.                 |    i>len || str.[i]<>'#'    = i
  80.                 |    otherwise                = FirstNonEmpty (i+1) len str
  81.                 
  82.                 LastNonEmpty :: !Int String -> Int
  83.                 LastNonEmpty i str
  84.                 |    i<0 || str.[i]<>'#'        = i
  85.                 |    otherwise                = LastNonEmpty (i-1) str
  86.  
  87.  
  88.  
  89. //    Read a Turing Machine from a file
  90. ReadTuring :: !String !Disk -> (!Int,!Turing,!Disk)
  91. ReadTuring filename disk
  92. #    (success,file,disk)    = fopen filename FReadText disk
  93. |    not success            = (-2,DummyTuring,disk)
  94. #    (linenr,turing,file)= ReadTuringFile file
  95.     (_,disk)            = fclose file disk
  96. |    otherwise            = (linenr,turing,disk)
  97. where
  98.     ReadTuringFile :: !*File -> (!Int,!Turing,!*File)
  99.     ReadTuringFile file
  100.     #    (linenr,trs,file)    = ReadTransitions 1 file
  101.     |    linenr<>0            = (linenr, DummyTuring, file)
  102.     #    (cont,file)            = ReadTape file
  103.     |    otherwise            = (linenr, {transitions=trs,tape={content=cont,head=size cont-1},state="S"},file)
  104.     where
  105.         ReadTape :: !*File -> (!String,!*File)
  106.         ReadTape file
  107.         #    (line,file)                    = freadline file
  108.         |    line==""                    = ("##",file)
  109.         #    first                        = line.[0]
  110.         |    first<>'|' && first<>'\n'    = (ParseTape 0 (size line) line,file)
  111.         |    otherwise                    = ReadTape file
  112.         where
  113.             ParseTape :: !Int !Int !String -> String
  114.             ParseTape i l s
  115.             |    i>=l                        = s
  116.             |    c==' ' || c=='|' || c=='\n'    = s%(0,i-1)
  117.             |    otherwise                    = ParseTape (i+1) l s
  118.             where
  119.                 c    = s.[i]
  120.         
  121.         ReadTransitions :: Int !*File -> (!Int,![Transition],!*File)
  122.         ReadTransitions linenr file
  123.         |    sfend file                    = (-1,[],file)
  124.         #    (line,file)                    = freadline file
  125.             (error,tape,comment,trans)    = ParseLine line
  126.         |    error                        = (linenr,[],file)
  127.         |    tape                        = (0,[],file)
  128.         #    (lnr,rest,file)                = ReadTransitions (linenr+1) file
  129.         |    comment                        = (lnr,rest,file)
  130.         |    otherwise                    = (lnr,[trans:rest],file)
  131.         where
  132.             ParseLine :: !String -> (!Bool,!Bool,!Bool,!Transition)
  133.             ParseLine s
  134.             |    s%(0,3)=="Tape"                = (False,True, False,DummyTrans)
  135.             |    first=='|' || first=='\n'    = (False,False,True, DummyTrans)
  136.             |    otherwise                    = (error,False,False,trans)
  137.             where
  138.                 (error,trans)                = ParseTransition s
  139.                 first                        = s.[0]
  140.                 
  141.                 ParseTransition :: !String -> (!Bool,!Transition)
  142.                 ParseTransition s
  143.                 #    i                = SkipLayout 0 len s
  144.                     (error,start,i)    = ParseState   i i len s
  145.                 |    error            = (True, DummyTrans)
  146.                 #    (error,i)        = DemandLayout i i len s
  147.                 |    error            = (True, DummyTrans)
  148.                 #    (error,sigma,i)    = ParseHead    i    len s
  149.                 |    error            = (True, DummyTrans)
  150.                 #    (error,i)        = DemandLayout i i len s
  151.                 |    error            = (True, DummyTrans)
  152.                 #    (error,end,i)    = ParseState   i i len s
  153.                 |    error            = (True, DummyTrans)
  154.                 #    (error,i)        = DemandLayout i i len s
  155.                 |    error            = (True, DummyTrans)
  156.                 #    (error,move,i)    = ParseHead    i    len s
  157.                 |    error            = (True, DummyTrans)
  158.                 |    otherwise        = (False,{start=start,sigma=sigma,end=end,move=move})
  159.                 where
  160.                     len                = size s
  161.                 
  162.                 ParseState :: Int !Int !Int String -> (!Bool,!State,!Int)
  163.                 ParseState b i l s
  164.                 |    i>=l || i-b>4 || (is_layout && i==b)    = (True,"",0)
  165.                 |    is_layout && i>b                        = (False, s%(b,i-1),i)
  166.                 |    otherwise                                = ParseState b (i+1) l s
  167.                 where
  168.                     is_layout                                = IsLayoutChar i s
  169.                 
  170.                 ParseHead :: !Int !Int String -> (!Bool,!Char,!Int)
  171.                 ParseHead i l s
  172.                 |    i>=l || IsLayoutChar i s        = (True,' ',0)
  173.                 |    otherwise                        = (False,s.[i],i+1)
  174.                 
  175.                 DemandLayout :: Int !Int !Int String -> (!Bool,!Int)
  176.                 DemandLayout b i l s
  177.                 |    i>=l || (is_no_layout && i==b)    = (True ,0)
  178.                 |    is_no_layout && i>b                = (False,i)
  179.                 |    otherwise                        = DemandLayout b (i+1) l s
  180.                 where
  181.                     is_no_layout                    = not (IsLayoutChar i s)
  182.                 
  183.                 SkipLayout :: !Int !Int String -> Int
  184.                 SkipLayout i l s
  185.                 |    i>=l                = i-1
  186.                 |    IsLayoutChar i s    = SkipLayout (i+1) l s
  187.                 |    otherwise            = i
  188.                 
  189.                 IsLayoutChar :: !Int !String -> Bool
  190.                 IsLayoutChar i s
  191.                 =    c==' ' || c=='(' || c==')' || c=='-' || c=='>' ||
  192.                     c==',' || c=='.' || c=='[' || c==']' || c=='{' ||
  193.                     c=='}' || c==' ' || c==':'
  194.                 where
  195.                     c    = s.[i]
  196.  
  197.  
  198. //    Given a pathname, return the filename (remove the path).
  199. RemovePath :: !String -> String
  200. RemovePath s
  201. |    found                    = s%(position+1,length_min_1)
  202. |    otherwise                = s
  203. where
  204.     (found,position)        = LastColon s length_min_1
  205.     length_min_1            = size s-1
  206.     
  207.     LastColon :: String !Int -> (!Bool,!Int)
  208.     LastColon s i
  209.     |    i<=0                = (False,0)
  210.     |    DirSeparator==s.[i]    = (True,i)
  211.     |    otherwise            = LastColon s (i-1)
  212.